home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 / Ham Radio 2000.iso / ham2000 / misc / dspice0s / topchk.c < prev    next >
C/C++ Source or Header  |  1992-11-21  |  21KB  |  700 lines
  1. /* topchk.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     integer ielmnt, isbckt, nsbckt, iunsat, nunsat, itemps, numtem, isens, 
  12.         nsens, ifour, nfour, ifield, icode, idelim, icolum, insize, 
  13.         junode, lsbkpt, numbkp, iorder, jmnode, iur, iuc, ilc, ilr, 
  14.         numoff, isr, nmoffc, iseq, iseq1, neqn, nodevs, ndiag, iswap, 
  15.         iequa, macins, lvnim1, lx0, lvn, lynl, lyu, lyl, lx1, lx2, lx3, 
  16.         lx4, lx5, lx6, lx7, ld0, ld1, ltd, imynl, imvn, lcvn, nsnod, 
  17.         nsmat, nsval, icnod, icmat, icval, loutpt, lpol, lzer, irswpf, 
  18.         irswpr, icswpf, icswpr, irpt, jcpt, irowno, jcolno, nttbr, nttar, 
  19.         lvntmp;
  20. } tabinf_;
  21.  
  22. #define tabinf_1 tabinf_
  23.  
  24. struct {
  25.     doublereal atime, aprog[3], adate, atitle[10], defl, defw, defad, defas, 
  26.         rstats[50];
  27.     integer iwidth, lwidth, nopage;
  28. } miscel_;
  29.  
  30. #define miscel_1 miscel_
  31.  
  32. struct {
  33.     integer locate[50], jelcnt[50], nunods, ncnods, numnod, nstop, nut, nlt, 
  34.         nxtrm, ndist, ntlin, ibr, numvs, numalt, numcyc;
  35. } cirdat_;
  36.  
  37. #define cirdat_1 cirdat_
  38.  
  39. struct {
  40.     integer iprnta, iprntl, iprntm, iprntn, iprnto, limtim, limpts, lvlcod, 
  41.         lvltim, itl1, itl2, itl3, itl4, itl5, itl6, igoof, nogo, keof;
  42. } flags_;
  43.  
  44. #define flags_1 flags_
  45.  
  46. struct {
  47.     doublereal value[200000];
  48. } blank_;
  49.  
  50. #define blank_1 blank_
  51.  
  52. struct {
  53.     doublereal omega, time, delta, delold[7], ag[7], vt, xni, egfet, xmu, 
  54.         sfactr;
  55.     integer mode, modedc, icalc, initf, method, iord, maxord, noncon, iterno, 
  56.         itemno, nosolv, modac, ipiv, ivmflg, ipostp, iscrch, iofile;
  57. } status_;
  58.  
  59. #define status_1 status_
  60.  
  61. /* Table of constant values */
  62.  
  63. static integer c__0 = 0;
  64. static integer c__1 = 1;
  65.  
  66. /*<       subroutine topchk >*/
  67. /* Subroutine */ int topchk_()
  68. {
  69.     /* Initialized data */
  70.  
  71.     static struct {
  72.     char e_1[32];
  73.     doublereal e_2;
  74.     } equiv_41 = { {'e', 'l', 'e', 'm', 'e', 'n', 't', ' ', 'n', 'o', 'd',
  75.          'e', ' ', 't', 'a', 'b', 'l', 'e', ' ', ' ', ' ', ' ', ' ', 
  76.         ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  77.  
  78. #define toptit ((doublereal *)&equiv_41)
  79.  
  80.     static integer idlist[4] = { 3,6,8,9 };
  81.     static integer idlis2[4] = { 14,14,14,11 };
  82.     static struct {
  83.     char e_1[8];
  84.     doublereal e_2;
  85.     char e_3[8];
  86.     doublereal e_4[2];
  87.     char e_5[8];
  88.     doublereal e_6;
  89.     char e_7[16];
  90.     doublereal e_8;
  91.     char e_9[32];
  92.     doublereal e_10[2];
  93.     char e_11[8];
  94.     doublereal e_12[3];
  95.     } equiv_42 = { {'r', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0., {'l', ' '
  96.         , ' ', ' ', ' ', ' ', ' ', ' '}, 0., 0., {'e', ' ', ' ', ' ', 
  97.         ' ', ' ', ' ', ' '}, 0., {'h', ' ', ' ', ' ', ' ', ' ', ' ', 
  98.         ' ', 'v', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0., {'d', ' ', 
  99.         ' ', ' ', ' ', ' ', ' ', ' ', 'q', ' ', ' ', ' ', ' ', ' ', 
  100.         ' ', ' ', 'j', ' ', ' ', ' ', ' ', ' ', ' ', ' ', 'm', ' ', 
  101.         ' ', ' ', ' ', ' ', ' ', ' '}, 0., 0., {'t', ' ', ' ', ' ', 
  102.         ' ', ' ', ' ', ' '}, 0., 0., 0. };
  103.  
  104. #define aide ((doublereal *)&equiv_42)
  105.  
  106.     static integer nnods[20] = { 2,2,2,0,2,2,2,2,2,2,2,4,3,4,4,4,4,0,0,0 };
  107.  
  108.     /* Format strings */
  109.     static char fmt_1511[] = "(\0020\002,i7)";
  110.     static char fmt_1521[] = "(\0020\002,i7,3x,12(1x,a8))";
  111.     static char fmt_1526[] = "(11x,12(1x,a8))";
  112.     static char fmt_1557[] = "(\0020*error*:  less than 2 connections at nod\
  113. e \002,i6/)";
  114.     static char fmt_1561[] = "(\0020*error*:  no dc path to ground from node\
  115.  \002,i6/)";
  116.     static char fmt_1711[] = "(\0020*error*:  inductor/voltage source loop f\
  117. ound, containing \002,a8/)";
  118.  
  119.     /* System generated locals */
  120.     integer i_1, i_2, i_3;
  121.  
  122.     /* Builtin functions */
  123.     integer s_wsfe(), do_fio(), e_wsfe();
  124.  
  125.     /* Local variables */
  126.     static integer node, nloc, locv, kntr, node1, node2;
  127.     extern /* Subroutine */ int getm4_(), copy4_(), zero4_();
  128.     static integer i, j, k, iflag, jflag, istop, jstop, ispot, kstop;
  129.     extern /* Subroutine */ int title_();
  130.     static integer id, change;
  131.     static doublereal atable[12];
  132.     static integer itabid, itable;
  133. #define nodplc ((integer *)&blank_1)
  134. #define cvalue ((complex *)&blank_1)
  135.     static integer kntlim;
  136.     extern /* Subroutine */ int extmem_();
  137.     static integer jstart, idcntr;
  138.     extern /* Subroutine */ int clrmem_();
  139.     static integer loc;
  140.  
  141.     /* Fortran I/O blocks */
  142.     static cilist io__25 = { 0, 0, 0, fmt_1511, 0 };
  143.     static cilist io__30 = { 0, 0, 0, fmt_1521, 0 };
  144.     static cilist io__31 = { 0, 0, 0, fmt_1526, 0 };
  145.     static cilist io__32 = { 0, 0, 0, fmt_1521, 0 };
  146.     static cilist io__33 = { 0, 0, 0, fmt_1526, 0 };
  147.     static cilist io__34 = { 0, 0, 0, fmt_1557, 0 };
  148.     static cilist io__35 = { 0, 0, 0, fmt_1561, 0 };
  149.     static cilist io__40 = { 0, 0, 0, fmt_1711, 0 };
  150.  
  151.  
  152. /*<       implicit double precision (a-h,o-z) >*/
  153.  
  154. /*     this routine constructs the element node table.  it also checks */
  155. /* for voltage source/inductor loops, current source/capacitor cutsets, */
  156.  
  157. /* and that every node has a dc (conductive) path to ground */
  158.  
  159. /* spice version 2g.6  sccsid=tabinf 3/15/83 */
  160. /*<       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, >*/
  161. /*<      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, >*/
  162. /*<      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, >*/
  163. /*<      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, >*/
  164. /*<      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, >*/
  165. /*<      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval, >*/
  166. /*<      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt, >*/
  167. /*<      7   irowno,jcolno,nttbr,nttar,lvntmp >*/
  168. /* spice version 2g.6  sccsid=miscel 3/15/83 */
  169. /*<       common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad, >*/
  170. /*<      1  defas,rstats(50),iwidth,lwidth,nopage >*/
  171. /* spice version 2g.6  sccsid=cirdat 3/15/83 */
  172. /*<       common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop, >*/
  173. /*<      1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc >*/
  174. /* spice version 2g.6  sccsid=flags 3/15/83 */
  175. /*<       common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts, >*/
  176. /*<      1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof >*/
  177. /* spice version 2g.6  sccsid=blank 3/15/83 */
  178. /*<       common /blank/ value(200000) >*/
  179. /* spice version 2g.6  sccsid=status 3/15/83 */
  180. /*<       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet, >*/
  181. /*<      1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon, >*/
  182. /*<      2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile >*/
  183. /*<       integer nodplc(64) >*/
  184. /*<       complex cvalue(32) >*/
  185. /*<       equivalence (value(1),nodplc(1),cvalue(1)) >*/
  186. /*<       integer change >*/
  187.  
  188.  
  189. /*<       dimension atable(12),aide(20),nnods(20) >*/
  190. /*<       dimension idlist(4),idlis2(4) >*/
  191. /*<       dimension toptit(4) >*/
  192. /*<       data toptit / 8helement , 8hnode tab, 8hle      , 8h         / >*/
  193. /*<       data idlist / 3, 6, 8, 9 / >*/
  194. /*<       data idlis2 /14,14,14,11 / >*/
  195. /*<       data aide / 1hr,0.0d0,1hl,2*0.0d0,1he,0.0d0,1hh,1hv,0.0d0,1hd, >*/
  196. /*<      1   1hq,1hj,1hm,0.0d0,0.0d0,1ht,0.0d0,0.0d0,0.0d0 / >*/
  197. /*<       data nnods / 2,2,2,0,2,2,2,2,2,2,2,4,3,4,4,4,4,0,0,0 / >*/
  198. /*<       data ablnk /1h / >*/
  199.  
  200. /*  allocate storage */
  201.  
  202. /*<       call getm4(iorder,ncnods) >*/
  203.     getm4_(&tabinf_1.iorder, &cirdat_1.ncnods);
  204. /*<       call getm4(iur,ncnods+1) >*/
  205.     i_1 = cirdat_1.ncnods + 1;
  206.     getm4_(&tabinf_1.iur, &i_1);
  207.  
  208. /*  construct node table */
  209.  
  210. /*<       kntlim=lwidth/11 >*/
  211.     kntlim = miscel_1.lwidth / 11;
  212. /*<  1300 call getm4(itable,0) >*/
  213. /* L1300: */
  214.     getm4_(&itable, &c__0);
  215. /*<       call getm4(itabid,0) >*/
  216.     getm4_(&itabid, &c__0);
  217. /*<       istop=ncnods+1 >*/
  218.     istop = cirdat_1.ncnods + 1;
  219. /*<       do 1310 i=1,istop >*/
  220.     i_1 = istop;
  221.     for (i = 1; i <= i_1; ++i) {
  222. /*<  1310 nodplc(iur+i)=1 >*/
  223. /* L1310: */
  224.     nodplc[tabinf_1.iur + i - 1] = 1;
  225.     }
  226. /*<       do 1370 id=1,18 >*/
  227.     for (id = 1; id <= 18; ++id) {
  228. /*<       if (nnods(id).eq.0) go to 1370 >*/
  229.     if (nnods[id - 1] == 0) {
  230.         goto L1370;
  231.     }
  232. /*<       loc=locate(id) >*/
  233.     loc = cirdat_1.locate[id - 1];
  234. /*<  1320 if (loc.eq.0) go to 1370 >*/
  235. L1320:
  236.     if (loc == 0) {
  237.         goto L1370;
  238.     }
  239. /*<       nloc=loc+1 >*/
  240.     nloc = loc + 1;
  241. /*<       jstop=nnods(id) >*/
  242.     jstop = nnods[id - 1];
  243. /*<  1330 do 1360 j=1,jstop >*/
  244. /* L1330: */
  245.     i_1 = jstop;
  246.     for (j = 1; j <= i_1; ++j) {
  247. /*<       node=nodplc(nloc+j) >*/
  248.         node = nodplc[nloc + j - 1];
  249. /*<       ispot=nodplc(iur+node+1) >*/
  250.         ispot = nodplc[tabinf_1.iur + node];
  251. /*<       k=nodplc(iur+ncnods+1) >*/
  252.         k = nodplc[tabinf_1.iur + cirdat_1.ncnods];
  253. /*<       call extmem(itable,1) >*/
  254.         extmem_(&itable, &c__1);
  255. /*<       call extmem(itabid,1) >*/
  256.         extmem_(&itabid, &c__1);
  257. /*<       if (k.le.ispot) go to 1340 >*/
  258.         if (k <= ispot) {
  259.         goto L1340;
  260.         }
  261. /*<       call copy4(nodplc(itable+ispot),nodplc(itable+ispot+1),k-ispot) >*/
  262.         i_2 = k - ispot;
  263.         copy4_(&nodplc[itable + ispot - 1], &nodplc[itable + ispot], &i_2)
  264.             ;
  265. /*<       call copy4(nodplc(itabid+ispot),nodplc(itabid+ispot+1),k-ispot) >*/
  266.         i_2 = k - ispot;
  267.         copy4_(&nodplc[itabid + ispot - 1], &nodplc[itabid + ispot], &i_2)
  268.             ;
  269. /*<  1340 nodplc(itable+ispot)=loc >*/
  270. L1340:
  271.         nodplc[itable + ispot - 1] = loc;
  272. /*<       nodplc(itabid+ispot)=id >*/
  273.         nodplc[itabid + ispot - 1] = id;
  274. /* ...  treat the substrate node of a mosfet as if it were a 
  275. transmission */
  276. /* ...  line node, i.e. let it dangle if desired */
  277. /*<       if(id.eq.14.and.j.eq.4) nodplc(itabid+ispot)=17 >*/
  278.         if (id == 14 && j == 4) {
  279.         nodplc[itabid + ispot - 1] = 17;
  280.         }
  281. /*<       k=node >*/
  282.         k = node;
  283. /*<       kstop=ncnods+1 >*/
  284.         kstop = cirdat_1.ncnods + 1;
  285. /*<  1350 k=k+1 >*/
  286. L1350:
  287.         ++k;
  288. /*<       if (k.gt.kstop) go to 1360 >*/
  289.         if (k > kstop) {
  290.         goto L1360;
  291.         }
  292. /*<       nodplc(iur+k)=nodplc(iur+k)+1 >*/
  293.         ++nodplc[tabinf_1.iur + k - 1];
  294. /*<       go to 1350 >*/
  295.         goto L1350;
  296. /*<  1360 continue >*/
  297. L1360:
  298.     ;}
  299. /*<       loc=nodplc(loc) >*/
  300.     loc = nodplc[loc - 1];
  301. /*<       go to 1320 >*/
  302.     goto L1320;
  303. /*<  1370 continue >*/
  304. L1370:
  305.     ;}
  306.  
  307. /*  check that every node has a dc path to ground */
  308.  
  309. /*<       call zero4(nodplc(iorder+1),ncnods) >*/
  310.     zero4_(&nodplc[tabinf_1.iorder], &cirdat_1.ncnods);
  311. /*<       nodplc(iorder+1)=1 >*/
  312.     nodplc[tabinf_1.iorder] = 1;
  313. /*<  1420 iflag=0 >*/
  314. L1420:
  315.     iflag = 0;
  316. /*<       do 1470 i=2,ncnods >*/
  317.     i_1 = cirdat_1.ncnods;
  318.     for (i = 2; i <= i_1; ++i) {
  319. /*<       if (nodplc(iorder+i).eq.1) go to 1470 >*/
  320.     if (nodplc[tabinf_1.iorder + i - 1] == 1) {
  321.         goto L1470;
  322.     }
  323. /*<       jstart=nodplc(iur+i) >*/
  324.     jstart = nodplc[tabinf_1.iur + i - 1];
  325. /*<       jstop=nodplc(iur+i+1)-1 >*/
  326.     jstop = nodplc[tabinf_1.iur + i] - 1;
  327. /*<       if (jstart.gt.jstop) go to 1470 >*/
  328.     if (jstart > jstop) {
  329.         goto L1470;
  330.     }
  331. /*<       do 1450 j=jstart,jstop >*/
  332.     i_2 = jstop;
  333.     for (j = jstart; j <= i_2; ++j) {
  334. /*<       loc=nodplc(itable+j) >*/
  335.         loc = nodplc[itable + j - 1];
  336. /*<       id=nodplc(itabid+j) >*/
  337.         id = nodplc[itabid + j - 1];
  338. /*<       if (aide(id).eq.0.0d0) go to 1450 >*/
  339.         if (aide[id - 1] == 0.) {
  340.         goto L1450;
  341.         }
  342. /*<       if (id.eq.17) go to 1445 >*/
  343.         if (id == 17) {
  344.         goto L1445;
  345.         }
  346. /*<       kstop=loc+nnods(id)-1 >*/
  347.         kstop = loc + nnods[id - 1] - 1;
  348. /*<       do 1440 k=loc,kstop >*/
  349.         i_3 = kstop;
  350.         for (k = loc; k <= i_3; ++k) {
  351. /*<       node=nodplc(k+2) >*/
  352.         node = nodplc[k + 1];
  353. /*<       if (nodplc(iorder+node).eq.1) go to 1460 >*/
  354.         if (nodplc[tabinf_1.iorder + node - 1] == 1) {
  355.             goto L1460;
  356.         }
  357. /*<  1440 continue >*/
  358. /* L1440: */
  359.         }
  360. /*<       go to 1450 >*/
  361.         goto L1450;
  362. /*<  1445 if (nodplc(loc+2).eq.i) node=nodplc(loc+3) >*/
  363. L1445:
  364.         if (nodplc[loc + 1] == i) {
  365.         node = nodplc[loc + 2];
  366.         }
  367. /*<       if (nodplc(loc+3).eq.i) node=nodplc(loc+2) >*/
  368.         if (nodplc[loc + 2] == i) {
  369.         node = nodplc[loc + 1];
  370.         }
  371. /*<       if (nodplc(loc+4).eq.i) node=nodplc(loc+5) >*/
  372.         if (nodplc[loc + 3] == i) {
  373.         node = nodplc[loc + 4];
  374.         }
  375. /*<       if (nodplc(loc+5).eq.i) node=nodplc(loc+4) >*/
  376.         if (nodplc[loc + 4] == i) {
  377.         node = nodplc[loc + 3];
  378.         }
  379. /*<       if (nodplc(iorder+node).eq.1) go to 1460 >*/
  380.         if (nodplc[tabinf_1.iorder + node - 1] == 1) {
  381.         goto L1460;
  382.         }
  383. /*<  1450 continue >*/
  384. L1450:
  385.     ;}
  386. /*<       go to 1470 >*/
  387.     goto L1470;
  388. /*<  1460 nodplc(iorder+i)=1 >*/
  389. L1460:
  390.     nodplc[tabinf_1.iorder + i - 1] = 1;
  391. /*<       iflag=1 >*/
  392.     iflag = 1;
  393. /*<  1470 continue >*/
  394. L1470:
  395.     ;}
  396. /*<       if (iflag.eq.1) go to 1420 >*/
  397.     if (iflag == 1) {
  398.     goto L1420;
  399.     }
  400.  
  401. /*  print node table and topology error messages */
  402.  
  403. /*<       if (iprntn.eq.0) go to 1510 >*/
  404.     if (flags_1.iprntn == 0) {
  405.     goto L1510;
  406.     }
  407. /*<       call title(0,lwidth,1,toptit) >*/
  408.     title_(&c__0, &miscel_1.lwidth, &c__1, toptit);
  409. /*<  1510 do 1590 i=1,ncnods >*/
  410. L1510:
  411.     i_1 = cirdat_1.ncnods;
  412.     for (i = 1; i <= i_1; ++i) {
  413. /*<       jstart=nodplc(iur+i) >*/
  414.     jstart = nodplc[tabinf_1.iur + i - 1];
  415. /*<       jstop=nodplc(iur+i+1)-1 >*/
  416.     jstop = nodplc[tabinf_1.iur + i] - 1;
  417. /*<       if (iprntn.eq.0) go to 1550 >*/
  418.     if (flags_1.iprntn == 0) {
  419.         goto L1550;
  420.     }
  421. /*<       if (jstart.le.jstop) go to 1520 >*/
  422.     if (jstart <= jstop) {
  423.         goto L1520;
  424.     }
  425. /*<       write (iofile,1511) nodplc(junode+i) >*/
  426.     io__25.ciunit = status_1.iofile;
  427.     s_wsfe(&io__25);
  428.     do_fio(&c__1, (char *)&nodplc[tabinf_1.junode + i - 1], (ftnlen)
  429.         sizeof(integer));
  430.     e_wsfe();
  431. /*<  1511 format(1h0,i7) >*/
  432. /*<       go to 1550 >*/
  433.     goto L1550;
  434. /*<  1520 kntr=0 >*/
  435. L1520:
  436.     kntr = 0;
  437. /*<       jflag=1 >*/
  438.     jflag = 1;
  439. /*<       do 1540 j=jstart,jstop >*/
  440.     i_2 = jstop;
  441.     for (j = jstart; j <= i_2; ++j) {
  442. /*<       loc=nodplc(itable+j) >*/
  443.         loc = nodplc[itable + j - 1];
  444. /*<       locv=nodplc(loc+1) >*/
  445.         locv = nodplc[loc];
  446. /*<       kntr=kntr+1 >*/
  447.         ++kntr;
  448. /*<       atable(kntr)=value(locv) >*/
  449.         atable[kntr - 1] = blank_1.value[locv - 1];
  450. /*<       if (kntr.lt.kntlim) go to 1540 >*/
  451.         if (kntr < kntlim) {
  452.         goto L1540;
  453.         }
  454. /*<       if (jflag.eq.0) go to 1525 >*/
  455.         if (jflag == 0) {
  456.         goto L1525;
  457.         }
  458. /*<       jflag=0 >*/
  459.         jflag = 0;
  460. /*<       write (iofile,1521) nodplc(junode+i),(atable(k),k=1,kntr) >*/
  461.         io__30.ciunit = status_1.iofile;
  462.         s_wsfe(&io__30);
  463.         do_fio(&c__1, (char *)&nodplc[tabinf_1.junode + i - 1], (ftnlen)
  464.             sizeof(integer));
  465.         i_3 = kntr;
  466.         for (k = 1; k <= i_3; ++k) {
  467.         do_fio(&c__1, (char *)&atable[k - 1], (ftnlen)sizeof(
  468.             doublereal));
  469.         }
  470.         e_wsfe();
  471. /*<  1521 format(1h0,i7,3x,12(1x,a8)) >*/
  472. /*<       go to 1530 >*/
  473.         goto L1530;
  474. /*<  1525 write (iofile,1526) (atable(k),k=1,kntr) >*/
  475. L1525:
  476.         io__31.ciunit = status_1.iofile;
  477.         s_wsfe(&io__31);
  478.         i_3 = kntr;
  479.         for (k = 1; k <= i_3; ++k) {
  480.         do_fio(&c__1, (char *)&atable[k - 1], (ftnlen)sizeof(
  481.             doublereal));
  482.         }
  483.         e_wsfe();
  484. /*<  1526 format(11x,12(1x,a8)) >*/
  485. /*<  1530 kntr=0 >*/
  486. L1530:
  487.         kntr = 0;
  488. /*<  1540 continue >*/
  489. L1540:
  490.     ;}
  491. /*<       if (kntr.eq.0) go to 1550 >*/
  492.     if (kntr == 0) {
  493.         goto L1550;
  494.     }
  495. /*<       if (jflag.eq.0) go to 1545 >*/
  496.     if (jflag == 0) {
  497.         goto L1545;
  498.     }
  499. /*<       write (iofile,1521) nodplc(junode+i),(atable(k),k=1,kntr) >*/
  500.     io__32.ciunit = status_1.iofile;
  501.     s_wsfe(&io__32);
  502.     do_fio(&c__1, (char *)&nodplc[tabinf_1.junode + i - 1], (ftnlen)
  503.         sizeof(integer));
  504.     i_2 = kntr;
  505.     for (k = 1; k <= i_2; ++k) {
  506.         do_fio(&c__1, (char *)&atable[k - 1], (ftnlen)sizeof(doublereal));
  507.  
  508.     }
  509.     e_wsfe();
  510. /*<       go to 1550 >*/
  511.     goto L1550;
  512. /*<  1545 write (iofile,1526) (atable(k),k=1,kntr) >*/
  513. L1545:
  514.     io__33.ciunit = status_1.iofile;
  515.     s_wsfe(&io__33);
  516.     i_2 = kntr;
  517.     for (k = 1; k <= i_2; ++k) {
  518.         do_fio(&c__1, (char *)&atable[k - 1], (ftnlen)sizeof(doublereal));
  519.  
  520.     }
  521.     e_wsfe();
  522. /*<  1550 if (jstart-jstop) 1560,1552,1556 >*/
  523. L1550:
  524.     if ((i_2 = jstart - jstop) < 0) {
  525.         goto L1560;
  526.     } else if (i_2 == 0) {
  527.         goto L1552;
  528.     } else {
  529.         goto L1556;
  530.     }
  531.  
  532. /*  allow node with only one connection iff element is a t-line */
  533.  
  534. /*<  1552 if (nodplc(itabid+jstart).eq.17) go to 1560 >*/
  535. L1552:
  536.     if (nodplc[itabid + jstart - 1] == 17) {
  537.         goto L1560;
  538.     }
  539. /*<  1556 nogo=1 >*/
  540. L1556:
  541.     flags_1.nogo = 1;
  542. /*<       write (iofile,1557) nodplc(junode+i) >*/
  543.     io__34.ciunit = status_1.iofile;
  544.     s_wsfe(&io__34);
  545.     do_fio(&c__1, (char *)&nodplc[tabinf_1.junode + i - 1], (ftnlen)
  546.         sizeof(integer));
  547.     e_wsfe();
  548. /*<  1557 format('0*error*:  less than 2 connections at node ',i6/) >*/
  549. /*<       go to 1590 >*/
  550.     goto L1590;
  551. /*<  1560 if (nodplc(iorder+i).eq.1) go to 1590 >*/
  552. L1560:
  553.     if (nodplc[tabinf_1.iorder + i - 1] == 1) {
  554.         goto L1590;
  555.     }
  556. /*<       nogo=1 >*/
  557.     flags_1.nogo = 1;
  558. /*<       write (iofile,1561) nodplc(junode+i) >*/
  559.     io__35.ciunit = status_1.iofile;
  560.     s_wsfe(&io__35);
  561.     do_fio(&c__1, (char *)&nodplc[tabinf_1.junode + i - 1], (ftnlen)
  562.         sizeof(integer));
  563.     e_wsfe();
  564. /*<  1561 format('0*error*:  no dc path to ground from node ',i6/) >*/
  565. /*<  1590 continue >*/
  566. L1590:
  567.     ;}
  568.  
  569. /*  check for inductor/voltage source loops */
  570.  
  571. /*<       do 1700 i=1,ncnods >*/
  572.     i_1 = cirdat_1.ncnods;
  573.     for (i = 1; i <= i_1; ++i) {
  574. /*<       call zero4(nodplc(iorder+1),ncnods) >*/
  575.     zero4_(&nodplc[tabinf_1.iorder], &cirdat_1.ncnods);
  576. /*<       nodplc(iorder+i)=-1 >*/
  577.     nodplc[tabinf_1.iorder + i - 1] = -1;
  578. /*<  1605 change=0 >*/
  579. L1605:
  580.     change = 0;
  581. /*<       do 1690 idcntr=1,4 >*/
  582.     for (idcntr = 1; idcntr <= 4; ++idcntr) {
  583. /*<       id=idlist(idcntr) >*/
  584.         id = idlist[idcntr - 1];
  585. /*<       loc=locate(id) >*/
  586.         loc = cirdat_1.locate[id - 1];
  587. /*<  1610 if ((loc.eq.0).or.(nodplc(loc+idlis2(idcntr)).ne.0)) go to 1690 >*/
  588. L1610:
  589.         if (loc == 0 || nodplc[loc + idlis2[idcntr - 1] - 1] != 0) {
  590.         goto L1690;
  591.         }
  592. /*<       node1=nodplc(loc+2) >*/
  593.         node1 = nodplc[loc + 1];
  594. /*<       node2=nodplc(loc+3) >*/
  595.         node2 = nodplc[loc + 2];
  596. /*<       if (nodplc(iorder+node1).eq.loc.or. >*/
  597. /*<      1   nodplc(iorder+node2).eq.loc) go to 1680 >*/
  598.         if (nodplc[tabinf_1.iorder + node1 - 1] == loc || nodplc[
  599.             tabinf_1.iorder + node2 - 1] == loc) {
  600.         goto L1680;
  601.         }
  602. /*<       if (nodplc(iorder+node1)) 1620,1640,1630 >*/
  603.         if ((i_2 = nodplc[tabinf_1.iorder + node1 - 1]) < 0) {
  604.         goto L1620;
  605.         } else if (i_2 == 0) {
  606.         goto L1640;
  607.         } else {
  608.         goto L1630;
  609.         }
  610. /*<  1620 nodplc(iorder+node1)=loc >*/
  611. L1620:
  612.         nodplc[tabinf_1.iorder + node1 - 1] = loc;
  613. /*<       change=1 >*/
  614.         change = 1;
  615. /*<  1630 node=node2 >*/
  616. L1630:
  617.         node = node2;
  618. /*<       go to 1670 >*/
  619.         goto L1670;
  620. /*<  1640 if (nodplc(iorder+node2)) 1650,1680,1660 >*/
  621. L1640:
  622.         if ((i_2 = nodplc[tabinf_1.iorder + node2 - 1]) < 0) {
  623.         goto L1650;
  624.         } else if (i_2 == 0) {
  625.         goto L1680;
  626.         } else {
  627.         goto L1660;
  628.         }
  629. /*<  1650 nodplc(iorder+node2)=loc >*/
  630. L1650:
  631.         nodplc[tabinf_1.iorder + node2 - 1] = loc;
  632. /*<       change=1 >*/
  633.         change = 1;
  634. /*<  1660 node=node1 >*/
  635. L1660:
  636.         node = node1;
  637. /*<  1670 if (nodplc(iorder+node).ne.0) go to 1710 >*/
  638. L1670:
  639.         if (nodplc[tabinf_1.iorder + node - 1] != 0) {
  640.         goto L1710;
  641.         }
  642. /*<       nodplc(iorder+node)=loc >*/
  643.         nodplc[tabinf_1.iorder + node - 1] = loc;
  644. /*<       change=1 >*/
  645.         change = 1;
  646. /*<  1680 loc=nodplc(loc) >*/
  647. L1680:
  648.         loc = nodplc[loc - 1];
  649. /*<       go to 1610 >*/
  650.         goto L1610;
  651. /*<  1690 continue >*/
  652. L1690:
  653.     ;}
  654. /*<       if (change.eq.1) go to 1605 >*/
  655.     if (change == 1) {
  656.         goto L1605;
  657.     }
  658. /*<  1700 continue >*/
  659. /* L1700: */
  660.     }
  661. /*<       go to 1900 >*/
  662.     goto L1900;
  663. /* ... loop found */
  664. /*<  1710 locv=nodplc(loc+1) >*/
  665. L1710:
  666.     locv = nodplc[loc];
  667. /*<       write (iofile,1711) value(locv) >*/
  668.     io__40.ciunit = status_1.iofile;
  669.     s_wsfe(&io__40);
  670.     do_fio(&c__1, (char *)&blank_1.value[locv - 1], (ftnlen)sizeof(doublereal)
  671.         );
  672.     e_wsfe();
  673. /*<  1711 format('0*error*:  inductor/voltage source loop found, containing >*/
  674. /*<      1',a8/) >*/
  675. /*<       nogo=1 >*/
  676.     flags_1.nogo = 1;
  677.  
  678.  
  679. /*<  1900 call clrmem(iorder) >*/
  680. L1900:
  681.     clrmem_(&tabinf_1.iorder);
  682. /*<       call clrmem(iur) >*/
  683.     clrmem_(&tabinf_1.iur);
  684. /*<       call clrmem(itable) >*/
  685.     clrmem_(&itable);
  686. /*<       call clrmem(itabid) >*/
  687.     clrmem_(&itabid);
  688. /*<  2000 return >*/
  689. /* L2000: */
  690.     return 0;
  691. /*<       end >*/
  692. } /* topchk_ */
  693.  
  694. #undef cvalue
  695. #undef nodplc
  696. #undef aide
  697. #undef toptit
  698.  
  699.  
  700.